home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / therm.exe / THERMTST.PAS < prev   
Pascal/Delphi Source File  |  1993-02-10  |  3KB  |  137 lines
  1. program testdial;
  2.  
  3. uses objects,views,app,drivers,menus,dialogs,crt,
  4.  
  5.      THERM;   {<-------}
  6.  
  7.  
  8. type
  9.   Ttest = object(TApplication)
  10.             constructor init;
  11.             procedure InitMenuBar; virtual;
  12.             procedure InitStatusLine; virtual;
  13.             procedure ShowDialog;
  14.             procedure HandleEvent(var Event:TEvent); virtual;
  15.           end;
  16.  
  17.  
  18. const
  19.    cmNow = 100;
  20.  
  21. {**************************************************************************}
  22. procedure Push_Event (Cmd : word);
  23. var
  24.   Put_Event : TEvent;
  25. begin
  26.   with Put_Event do
  27.   begin
  28.     What    := evCommand;
  29.     Command := Cmd;
  30.     InfoPtr := nil;
  31.   end; {with}
  32.   {*------------------------------------------------------*}
  33.   {* put it on the Event Schedule Queue                   *}
  34.   {*------------------------------------------------------*}
  35.   DeskTop^.PutEvent (Put_Event);
  36. end; {Push_Event}
  37.  
  38.  
  39. {**************************************************************************}
  40. constructor Ttest.Init;
  41. begin
  42.   TApplication.init;
  43.   Push_Event (cmNow);
  44. end; {init}
  45.  
  46. {**************************************************************************}
  47. procedure Ttest.InitMenuBar;
  48.   var R:TRect;
  49.   begin
  50.     GetExtent(R);
  51.     R.B.Y := R.A.Y +1;
  52.     MenuBar:= New(PMenuBar, Init(R, NewMenu(
  53.       NewSubMenu('~R~un It',hcNoContext, NewMenu(
  54.         NewItem('~R~un Demo (again)', 'F2', kbF2, cmNow, hcNoContext,
  55.         nil)),
  56.         nil)
  57.       )));
  58.   end;
  59.  
  60. {**************************************************************************}
  61. procedure Ttest.InitStatusLine;
  62. var
  63.   R: TRect;
  64. begin
  65.   GetExtent(R);
  66.   R.A.Y := R.B.Y-1;
  67.   StatusLine := New(PStatusLine, Init(R,
  68.     NewStatusDef(0, $FFFF,
  69.       NewStatusKey('', kbF10, cmMenu,
  70.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  71.       nil)), nil)));
  72. end;
  73.  
  74. {**************************************************************************}
  75. procedure Ttest.HandleEvent(var Event: TEvent);
  76.  begin {HandleEvent}
  77.   TApplication.HandleEvent(Event);
  78.  
  79.   case Event.What of
  80.     evCommand:
  81.       begin
  82.         case Event.Command of
  83.           cmNow: ShowDialog;
  84.         else
  85.           Exit;
  86.         end;
  87.         ClearEvent(Event);
  88.       end;
  89.   end;
  90. end; {HandleEvent}
  91.  
  92. {**************************************************************************}
  93. procedure Ttest.ShowDialog;
  94. var
  95.   i : integer;
  96.   max : integer;
  97. begin
  98.  
  99.   i := 1;
  100.   max := 100;
  101.   {*********************************************}
  102.   {* first call with FALSE creates the dialog! *}
  103.   {*********************************************}
  104.   THERM.Thermometer ('Test Thermometer', 0, Max, FALSE);
  105.  
  106.   {*************************************}
  107.   {* Now call once per processing loop *}
  108.   {*************************************}
  109.   repeat
  110.     THERM.Thermometer ('Therm Processing', i, Max, FALSE);
  111.     INC (i);
  112.  
  113.     {************************************}
  114.     {* Put your actual processing here! *}
  115.     {* Ill cheat and put a delay        *}
  116.     {************************************}
  117.     CRT.Delay (30);
  118.   until (i = Max);
  119.  
  120.   {*******************************}
  121.   {* Important: TRUE disposes it *}
  122.   {*******************************}
  123.   THERM.Thermometer ('', 0, 0, TRUE);
  124.  
  125. end; {showdialog}
  126.  
  127.  
  128. {**************************}
  129. var
  130.   test: Ttest;
  131. begin {main app}
  132.   test.init;
  133.   test.run;
  134.   test.done;
  135. end.
  136.  
  137.